00100		SUBROUTINE ZFUNC
00200		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
00300		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
00400		COMMON FUNC(512),F2(512),K,I
00500	
00600	43	TYPE 1
00700		ACCEPT 100,MA,C
00720		IF(MA.NE.'B')GO TO 76
00740	430	KT=512
00760	C  FOR BACKUP
00780		RETURN
00900	76	IF(MA.EQ.'A')GO TO 75
00925		IF(MA.NE.'M')GO TO 73
00950	75	TYPE 39,B
01000		TYPE 2
01100		ACCEPT 3,FNM2
01150		IF(FNM2.EQ.'B')GO TO 43
03000	40	DO 4 K=1,10
03100	5	IF(FNM2.NE.FN(K))GO TO 4
03200		N2=K
03300		GO TO 72
03400	4	CONTINUE
03500		TYPE 74
03600		GO TO 75
03700	74	FORMAT(' FUNCTION NOT FOUND '/)
03800	72	CALL DPYF(N2,F2)
03910	7	TYPE 60
03940		ACCEPT 100,K
03970		IF(K.EQ.'B')GO TO 15
03975		IF(K.EQ.'N')GO TO 15
03980		IF(MA.EQ.'M')GO TO 102
04000	70	TYPE 10
04100		ACCEPT 11,R,R2
04150		REREAD 100,K
04175		IF(K.EQ.'B')GO TO 75
04200		IF(R2.EQ.0)R2=1
04300		IF(R.EQ.0)R=1
04400		DO 13 K=1,512
04450		X=FUNC(K)
04500		FUNC(K)=FUNC(K)*R+F2(K)*R2+C
04550	13	F2(K)=X
04600		GO TO 104
04700	73	IF(MA.NE.'C')GO TO 44
04716		DO 45 K=1,512
04732		F2(K)=FUNC(K)
04748	45	FUNC(K)=FUNC(K)+C
04764		GO TO 104
04780	44	IF(MA.NE.'I')GO TO 46
04796		DO 47 K=1,512
04812		F2(K)=FUNC(K)
04828	47	FUNC(K)=C-FUNC(K)
04844		GO TO 104
04860	46	IF(MA.NE.'R')GO TO 75
04876	48	DO 50 K=1,512
04892	50	F2(K)=FUNC(513-K)
04908		DO 51 K=1,512
04924		X=FUNC(K)
04940		FUNC(K)=F2(K)+C
04956	51	F2(K)=X
04972		GO TO 104
05000	102	DO 103 K=1,512
05050		X=FUNC(K)
05100		FUNC(K)=FUNC(K)*F2(K)+C
05150	103	F2(K)=X
05200	104	A(1,2)=520
05300		CALL NORM(FUNC)
05400	C   NORMALIZES THE FUNCTION
05500		CALL DPY(FUNC,1)
05600		TYPE 6
05700		ACCEPT 100,K
05800		IF(K.EQ.'M')GO TO 43
05900		IF(K.NE.'B')RETURN
05910		DO 14 K=1,512
05920	14	FUNC(K)=F2(K)
05940	15	CALL DPY(FUNC,1)
05950		GO TO 43
06000	1	FORMAT
06050	     1(' A(DD), M(ULT), R(ETRO), I(NVRT), OR C,N (=ADD CONSTANT N) ',$)
06100	100	FORMAT(A1,F)
06200	2	FORMAT(' 2ND FUNC? ',$)
06300	3	FORMAT(A3)
06400	10	FORMAT(' TYPE RATIO (E.G. 1,2) ',$)
06410	39	FORMAT(10(A1,A3))
06500	11	FORMAT(2F)
06600	6	FORMAT(' F(INISH), OR M(ORE)?  ',$)
06650	60	FORMAT(' GO ON?  ',$)
06700		END
06800	
06900		SUBROUTINE DPYF(N,F)
07000		COMMON/S/H,AMP,CON,PH /GRD/ON
07100		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
07200		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
07300		DIMENSION F(1)
07305		NODPY=-1
07310		IF(N.GT.0)GO TO 8
07320		N=JX
07330		NODPY=0
07400	CC COLGATE 6/74--SEE MAIN AT 1201-18	IF(XA(N).EQ.'SEG')GO TO 5
07410	8	IF(XA(N).NE.'SYNTH')GO TO 5
07500		CALL ZERO(F)
07600		K=1
07700	1	AMP=AA(2,K,N)
07800		H=AA(1,K,N)
07900		PH=AA(3,K,N)
08000		CON=AA(4,K,N)
08100		CALL SYN(F)
08200		K=K+1
08300		IF(AA(1,K,N).NE.999)GO TO 1
08400		CALL NORM(F)
08500		GO TO 4
08800	
08900	5	K=1
08920		G=AA(2,1,N)
09000		IF(G.EQ.520)GO TO 6
09010		J=1
09020		IF(G.LE.1)GO TO 22
09030		Y=0
09040		K=0
09045	C  FOR START BEYOND STEP 1 - ASSUMES A 0,1.
09050		GO TO 2
09100	22	Y=AA(1,1,N)
09300	2	K=K+1
09400		M=AA(2,K,N)*5.12+.5
09500		IF(M.GT.512)GO TO 6
09600		G=AA(1,K,N)
09700		Z=G-Y
09800		H=M-J+1
09850		IF(H.LT.1)H=1
09900		NN=0
10000		DO 3 L=J,M
10100		F(L)=(NN*Z)/H+Y
10200	3	NN=NN+1
10300		IF(M.EQ.512)GO TO 4
10400		Y=G
10500		J=M+1
10600		GO TO 2
10700	C  FOR LONG FUNCS.
10800	6	L=K+1
10900		DO 7 M=1,512
11000	7	F(M)=AA(M,L,N)
11100	4	IF(NODPY)CALL DPY(F,-1)
11110	C  NODPY=0 IS FOR PLOTTER AND LPT
11200	C  NOW FUNCTION IS FULL AND DISPLAYED
11400		END
11500	
11600		SUBROUTINE SYN(F)
11700		COMMON/S/H,AMP,CON,PH
11800		DIMENSION F(1)
11900		DATA FAC/0.703125/,FACP/1.422222/
12000		X=PH*FACP+1.0
12100	C  PHASE IS IN DEGREES (0 - 360)
12200	2016	DO 17 L=1,512
12300		XL=SIND(X*FAC)*AMP+CON
12400		IF(CON.LT.100.0)GO TO 1
12500		F(L)=(XL-100.)*F(L)
12600		GO TO 2
12700	1	F(L)=F(L)+XL
12800	C   NORMALIZES THE FUNCTION
12900	2	X=X+H
13000	17	IF(X.GT.512.)X=X-512.
13200		END
13300	
13400		SUBROUTINE ZERO(F)
13500		DIMENSION F(1)
13600		DO 1 K=1,512
13700	1	F(K)=0
13800		RETURN
13900		END
14000	
14100		SUBROUTINE NORM(F)
14200		DIMENSION F(1)
14300		X=F(1)
14400	C   NORMALIZES THE FUNCTION
14500		DO 19 K=2,512
14600		XK=ABS(F(K))
14700	19	IF(X.LT.XK)X=XK
14800		DO 20 K=1,512
14900	20	F(K)=F(K)/X
15000		RETURN
15100		END